home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / COMMODOR / EDIT.ARC / CHAR EDITOR (.txt) next >
Commodore BASIC  |  2000-06-30  |  8KB  |  218 lines
  1. 86 REM *************************************
  2. 87 REM *                                   *
  3. 88 REM *            CREATED FOR            *
  4. 89 REM *                                   *
  5. 90 REM *  THE COMMODORE EDUCATIONAL GROUP  *
  6. 91 REM *                                   *
  7. 92 REM *                BY                 *
  8. 93 REM *                                   *
  9. 94 REM *         GARRY G. KIZIAK           *
  10. 95 REM *                                   *
  11. 96 REM *         COPYRIGHT  1982           *
  12. 97 REM *                                   *
  13. 98 REM *************************************
  14. 99 :
  15. 100 IF V=0 THEN GOSUB 1120
  16. 110 PRINT LEFT$(V$,7)TAB(18)LEFT$(BL$,9)
  17. 120 PRINT:PRINT TAB(18)LEFT$(BL$,16)
  18. 130 GOSUB 610:GOSUB 1160:GOSUB 620:GOSUB 860:GOSUB 650
  19. 140 FOR I=0 TO 7:P=PEEK(L+I):POKE Z+I,P:NEXT
  20. 150 GOSUB 570:X=0:Y=0:GOSUB 590
  21. 160 P=1148+X+Y*40:Q=PEEK(P):R=Q
  22. 170 R=(NOTRAND128)OR(NOT128ANDR)
  23. 180 POKE P,R
  24. 190 FOR I=1 TO 30:GET A$:IF A$="" THEN NEXT:GOTO 170
  25. 200 POKE P,Q
  26. 210 IF A$="" THEN X=(X+1)AND7:GOTO 160
  27. 220 IF A$="[157]" THEN X=(X-1)AND7:GOTO 160
  28. 230 IF A$="" THEN Y=(Y+1)AND7:GOTO 160
  29. 240 IF A$="[145]" THEN Y=(Y-1)AND7:GOTO 160
  30. 250 IF A$=DE$ THEN X=(X-1)AND7:P=1148+X+Y*40:POKE P,46:T=Z+Y
  31. 260 IF A$=DE$ THEN POKE T,PEEK(T)ANDH(X):GOTO 160
  32. 270 IF A$=" " THEN POKE P,46:T=Z+Y:POKE T,PEEK(T)ANDH(X):X=(X+1)AND7:GOTO 160
  33. 280 IF A$="." THEN POKE P,81:T=Z+Y:POKE T,PEEK(T)ORM(X):X=(X+1)AND7:GOTO 160
  34. 290 IF A$="[147]" THEN GOSUB 620:GOSUB 640:X=0:Y=0:GOTO 160
  35. 300 IF A$="Q" THEN GOSUB 620:GOSUB 640:DC=32:GOSUB 590:DC=255:GOSUB 650:GOTO 140
  36. 310 IF A$="" THEN X=0:Y=0:GOTO 160
  37. 320 IF A$=CR$ THEN X=0:Y=(Y+1)AND7:GOTO 160
  38. 330 IF A$="[133]" THEN FOR I=1 TO 7:POKE Z+I-1,PEEK(Z+I):NEXT:POKE Z+7,0:GOSUB 570
  39. 340 IF A$="[133]" THEN 160
  40. 350 IF A$="[134]" THEN FOR I=7 TO 1 STEP -1:POKE Z+I,PEEK(Z+I-1):NEXT:POKE Z,0
  41. 360 IF A$="[134]" THEN GOSUB 570:GOTO 160
  42. 370 IF A$="[135]" THEN FOR I=0 TO 7:POKE Z+I,(PEEK(Z+I)*2)AND255:NEXT
  43. 380 IF A$="[135]" THEN GOSUB 570:GOTO 160
  44. 390 IF A$="[136]" THEN FOR I=0 TO 7:POKE Z+I,(PEEK(Z+I)/2):NEXT
  45. 400 IF A$="[136]" THEN GOSUB 570:GOTO 160
  46. 410 IF A$="" THEN FOR I=0 TO 7:R=PEEK(Z+I):R=(NOTRAND255)OR(NOT255ANDR)
  47. 420 IF A$="" THEN POKE Z+I,R:NEXT:GOSUB 570:GOTO 160
  48. 430 IF A$="" THEN BG=(BG+1)AND15:POKE 53281,BG:GOTO 160
  49. 440 IF A$="" THEN BR=(BR+1)AND15:POKE 53280,BR:GOTO 160
  50. 450 IF A$="\" THEN GOSUB 580:GOSUB 570:GOTO 160
  51. 460 IF A$<>"" THEN 160
  52. 464 REM ****************************
  53. 465 REM *                          *
  54. 466 REM *  ASSIGN CHARACTER BEING  *
  55. 467 REM *     EDITED TO A KEY      *
  56. 468 REM *                          *
  57. 469 REM ****************************
  58. 470 PRINT "   ASSIGN TO    "
  59. 480 PRINT "      WHICH      "
  60. 490 PRINT "    CHARACTER    "
  61. 500 GOSUB 660
  62. 510 FOR I=0 TO 7:POKE L+I,PEEK(Z+I):NEXT:GOSUB 540
  63. 520 GOSUB 620:IF L<>Z THEN GOSUB 640
  64. 530 GOSUB 650:GOTO 140
  65. 540 PRINT "                "
  66. 550 PRINT "           "
  67. 560 PRINT "                 ":RETURN
  68. 565 REM ****************************
  69. 566 REM *                          *
  70. 567 REM *  PRINT CHARACTER ON GRID *
  71. 568 REM *                          *
  72. 569 REM ****************************
  73. 570 FOR I=0 TO 7:POKE 925+I,PEEK(Z+I):NEXT:SYS 933:RETURN
  74. 575 REM ****************************
  75. 576 REM *                          *
  76. 577 REM *   ROTATE EDIT CHARACTER  *
  77. 578 REM *                          *
  78. 579 REM ****************************
  79. 580 HI=INT(Z/256):LO=Z-256*HI:POKE 251,LO:POKE 252,HI:SYS 896:RETURN
  80. 584 REM ****************************
  81. 585 REM *                          *
  82. 586 REM *   PRINT EDIT CHARACTER   *
  83. 587 REM *     IN ALL 16 COLORS     *
  84. 588 REM *                          *
  85. 589 REM ****************************
  86. 590 J=0:FOR I=0 TO 15:K=IAND7:IF K=0 THEN J=J+80
  87. 600 POKE CL+2*K+J+54272,I:POKE CL+2*K+J,DC:NEXT:RETURN
  88. 605 REM ****************************
  89. 606 REM *                          *
  90. 607 REM *   CHANGE CHARACTER SET   *
  91. 608 REM *                          *
  92. 609 REM ****************************
  93. 610 CB=CS*2048:Z=CB+255*8:POKE V+24,17+2*CS:RETURN
  94. 615 REM ****************************
  95. 616 REM *                          *
  96. 617 REM *        PRINT GRID        *
  97. 618 REM *                          *
  98. 619 REM ****************************
  99. 620 PRINT "[172][162][162][162][162][162][162][162][162][187][146]":FOR I=1 TO 8:PRINT "[161]........[161]":NEXT
  100. 630 PRINT "[188][146][162][162][162][162][162][162][162][162][190]":RETURN
  101. 635 REM ****************************
  102. 636 REM *                          *
  103. 637 REM *   CLEAR EDIT CHARACTER   *
  104. 638 REM *                          *
  105. 639 REM ****************************
  106. 640 FOR I=0 TO 7:POKE Z+I,0:NEXT:RETURN
  107. 644 REM ****************************
  108. 645 REM *                          *
  109. 646 REM *    SELECT A CHARACTER    *
  110. 647 REM *        FOR EDITING       *
  111. 648 REM *                          *
  112. 649 REM ****************************
  113. 650 POKE V+21,0:POKE V+16,0:Z1=0:POKE V,52:POKE V+1,166
  114. 660 R=0
  115. 670 R=1-R:POKE V+21,R
  116. 680 FOR I=1 TO 20:GET A$:IF A$="" THEN NEXT:GOTO 670
  117. 690 POKE V+21,1:A=VAL(A$):IF A>0 AND A<8THENCS=A:GOSUB610:POKE1570,CS+176:GOTO 670
  118. 700 IF A$="" THEN BG=(BG+1)AND15:POKE 53281,BG:GOTO 670
  119. 710 IF A$="" THEN BR=(BR+1)AND15:POKE 53280,BR:GOTO 670
  120. 720 IF A$="" THEN TT=(TT+1)AND3:GOSUB 860:GOTO 670
  121. 730 IF A$="Q" THEN POKE V+21,0:PRINT"[147]";:END
  122. 740 IF CS=2 OR CS=3 THEN 670
  123. 750 IF A$="" THEN Z1=(Z1+1)AND63
  124. 760 IF A$="[157]" THEN Z1=(Z1-1)AND63
  125. 770 IF A$="[145]" THEN Z1=(Z1-16)AND63
  126. 780 IF A$="" THEN Z1=(Z1+16)AND63
  127. 790 IF A$=CR$ THEN GOSUB 540:DC=32:GOSUB 590:DC=255:P=Z1+TT*64:L=CB+P*8:RETURN
  128. 800 IF A$=" " THEN POKE V+21,0:GOSUB 880:GOTO 670
  129. 810 IF A$="S" THEN POKE V+21,0:GOSUB 970:GOTO 670
  130. 820 Y1=INT(Z1/16):X1=Z1-Y1*16:Y1=166+16*Y1:POKE V+21,0
  131. 830 IF X1<13 THEN X1=52+X1*16:FL=0:GOTO 850
  132. 840 IF X1>12 THEN X1=-12+(X1-12)*16:FL=1
  133. 850 POKE V+16,FL:POKE V,X1:POKE V+1,Y1:POKE V+21,1:GOTO 670
  134. 860 J=1548:FORI=0TO63:K=IAND15:IF K=0 THEN J=J+80
  135. 870 POKE 2*K+J,I+TT*64:NEXT:RETURN
  136. 875 REM ****************************
  137. 876 REM *                          *
  138. 877 REM *   LOAD A CHARACTER SET   *
  139. 878 REM *                          *
  140. 879 REM ****************************
  141. 880 PRINT "[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  142. 890 PRINT "     LOAD      [146]"
  143. 900 PRINT " CHARACTER SET [146]"
  144. 910 LI=9:COL=18:LE=16:PRINT LEFT$(V$,7)TAB(18)"FILENAME:"
  145. 920 MSG$="[146][146]":GOSUB 1230:FL$="0:"+IN$
  146. 930 IF IN$="" THEN GOSUB 1160:PRINT LEFT$(V$,7)TAB(18)"         ":RETURN
  147. 940 OPEN 1,8,15,"I0"
  148. 950 OPEN 2,8,0,FL$:GOSUB 1340:CLOSE2:CLOSE1
  149. 960 LOAD FL$,8,1
  150. 965 REM ****************************
  151. 966 REM *                          *
  152. 967 REM *   SAVE A CHARACTER SET   *
  153. 968 REM *                          *
  154. 969 REM ****************************
  155. 970 PRINT "[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  156. 980 PRINT "     SAVE      [146]"
  157. 990 PRINT " CHARACTER SET [146]"
  158. 1000 LI=8:COL=18:LE=16:PRINT LEFT$(V$,6)TAB(18)"FILENAME:"
  159. 1010 MSG$="[146][146]":GOSUB 1230:FL$="0:"+IN$+",PRG,WRITE"
  160. 1020 IF IN$="" THEN GOSUB 1160:PRINT LEFT$(V$,7)TAB(18)"         ":RETURN
  161. 1030 LI=11:COL=19:LE=1:MSG$="[146]SAVE TO SET?[146]":GOSUB 1230:TS=VAL(IN$)
  162. 1040 IF TS<1 OR TS=2 OR TS=3 OR TS>7 THEN 1030
  163. 1050 OPEN 1,8,15,"I0":GOSUB 1340
  164. 1060 OPEN 2,8,1,FL$:GOSUB 1340
  165. 1070 PRINT#2,CHR$(0);CHR$(8*TS);
  166. 1080 FOR I=0 TO 2047:PRINT#2,CHR$(PEEK(CB+I));:GOSUB 1340:NEXT:CLOSE2:CLOSE1
  167. 1090 PRINT LEFT$(V$,6)TAB(18)LEFT$(BL$,9):PRINT:PRINT TAB(18)LEFT$(BL$,16)
  168. 1100 PRINT LEFT$(V$,11)TAB(18)LEFT$(BL$,18):GOSUB 1160
  169. 1110 RETURN
  170. 1114 REM ****************************
  171. 1115 REM *                          *
  172. 1116 REM *   INITIALIZE VARIABLES   *
  173. 1117 REM *     AND ENABLE CURSOR    *
  174. 1118 REM *                          *
  175. 1119 REM ****************************
  176. 1120 POKE53281,1:PRINT "[147]":POKE53281,6:V=53248:CL=1024+5*40+18:DC=255:CS=1
  177. 1130 V$="":BL$="                                 "
  178. 1140 POKE 2040,13:POKE 53271,0:POKE 53277,0:DE$=CHR$(20):CR$=CHR$(13)
  179. 1150 FOR I=0 TO 7:M(I)=2^(7-I):H(I)=255-M(I):NEXT:RETURN
  180. 1155 REM ****************************
  181. 1156 REM *                          *
  182. 1157 REM *      SCREEN DISPLAY      *
  183. 1158 REM *                          *
  184. 1159 REM ****************************
  185. 1160 PRINT "  [164][164][164][164][164][164][164][164][164][164][164]  "
  186. 1170 PRINT "   CHARACTER [146]  "
  187. 1180 PRINT "     EDITOR  [146]  "
  188. 1190 PRINT LEFT$(V$,13)TAB(11)"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  189. 1200 PRINT "[172][162][162][162][162][162][162][162][162] CHARACTER SET"CS"[157] [146][162][162][162][162][162][162][162][162][162]"
  190. 1210 FOR I=1 TO 9:PRINT "[161][161]":NEXT
  191. 1220 PRINT "[188][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162]":RETURN
  192. 1225 REM ****************************
  193. 1226 REM *                          *
  194. 1227 REM *       INPUT ROUTINE      *
  195. 1228 REM *                          *
  196. 1229 REM ****************************
  197. 1230 Y9=2:IN$="":UC=0:UB$=LEFT$(BL$,LE):GOSUB 1330:UB$=" ":UC=3
  198. 1240 UT=TI
  199. 1250 GET Z9$:IF Z9$="" THEN 1310
  200. 1260 IF Z9$=CR$ THEN Y9=2:GOSUB 1330:PRINT "[157][157] ":RETURN
  201. 1270 IF Z9$=DE$ THEN ON -(LEN(IN$)=0) GOTO 1310:IN$=LEFT$(IN$,LEN(IN$)-1):GOTO1310
  202. 1280 IF (ASC(Z9$)AND127)<32 OR Z9$=CHR$(34) THEN 1310
  203. 1290 IF LE=LEN(IN$) THEN 1310
  204. 1300 IN$=IN$+Z9$
  205. 1310 GOSUB 1330:IF TI-UT<10 THEN 1250
  206. 1320 Y9=3-Y9:GOTO 1240
  207. 1330 PRINT LEFT$(V$,LI)TAB(COL-1)MID$(MSG$,Y9)UB$IN$MID$(" [146]",Y9,UC)" ";:RETURN
  208. 1335 REM ****************************
  209. 1336 REM *                          *
  210. 1337 REM *   CHECK FOR DISK ERRORS  *
  211. 1338 REM *                          *
  212. 1339 REM ****************************
  213. 1340 INPUT#1,A$,B$,C$,D$
  214. 1350 IF VAL(A$)=0 THEN RETURN
  215. 1360 PRINT"[147]DISK ERROR:[146] "B$
  216. 1370 CLOSE2
  217. 1380 END
  218.